#####################################
# Install/load packages and functions
#####################################

# remove objects
rm(list=ls())
# detach all libraries
detachAllPackages <- function() {
  basic.packages <- c("package:stats", "package:graphics", "package:grDevices", "package:utils", "package:datasets", "package:methods", "package:base")
  package.list <- search()[ifelse(unlist(gregexpr("package:", search()))==1, TRUE, FALSE)]
  package.list <- setdiff(package.list, basic.packages)
  if (length(package.list)>0)  for (package in package.list) detach(package,  character.only=TRUE)
}
detachAllPackages()

# load libraries
pkgTest <- function(pkg){
  new.pkg <- pkg[!(pkg %in% installed.packages()[,  "Package"])]
  if (length(new.pkg)) 
    install.packages(new.pkg,  dependencies = TRUE)
  sapply(pkg,  require,  character.only = TRUE)
}

# here is where you load any necessary packages
# ex: stringr
# lapply(c("stringr"),  pkgTest)

lapply(c("gtools"),  pkgTest)

# set working directory
setwd(dirname(rstudioapi::getActiveDocumentContext()$path))

# these functions are adapted from those in Abramson et al. (2022) in order to
# facilitate voters who choose to abstain
lapply(paste("functions", list.files("functions"), sep="/"), source)

#########
# TABLE 2
#########

# In the main paper, our presentation focuses on a five-voter example, and in
# the supplementary materials we generalize this to an N-voter setup.  Here, we
# use the adapted code to calculate the AMCEs presented in Table 2 of the main
# text.

# In this example, we have candidates that vary on two attributes (each of which
# can take on two levels) and four types of voters:
#     type 1 voters prefer pro-life candidates to pro-choice candidates and
#                      those that will cut taxes on the upper class to those
#                      that will raise them; abortion positions are more
#                      important than tax positions

#     type 2 voters prefer pro-choice candidates to pro-life candidates and
#                      those that will raise taxes on the upper class to those
#                      that will cut them; tax positions are more
#                      important than abortion positions

#     type 3 voters are type 1 voters who will abstain if no candidate is pro-life

#     type 4 voters are type 2 voters who will abstain if no candidate will raise
#     taxes on the upper class
# Table 1a in the main paper summarizes these voter preferences.

# this list and the construct_vote_abstain() function creates a dataframe that
# specifies how each voter type would vote in each possible choice scenario
voter_ranks <- list("1" = c("LD" = 1, "LI" = 2, "CD" = 3, "CI" = 4),
                    "2" = c("LD" = 4, "LI" = 3, "CD" = 2, "CI" = 1),
                    "3" = c("LD" = 1, "LI" = 2, "CD" = NA, "CI" = NA),
                    "4" = c("LD" = NA, "LI" = NA, "CD" = 2, "CI" = 1))
vote.mat <- construct_vote_abstain(voter_ranks)

# these empty objects will become vectors storing the AMCEs from each possible
# voter distribution
AMCE_abortion_four <- NULL
AMCE_taxes_four <- NULL

# in Table 2, we want to obtain the AMCEs in four scenarios:
#   1) when no one abstains
#   2) when all voter types abstain if no available candidate has their preferred
#      level of the abortion policy attribute
#   3) when pro-life voters abstain if no available candidate is pro-life
#   4) when pro-choice voters abstain if no available candidate is pro-choice
# Table 1b in the main paper tabulates the votes for each candidate in each 
# possible matchup depending upon which voters are allowed to abstain.

# the following list contains the weights of the four voter types that conform
# with those four scenarios, respectively

type_weights_four <- list(c(0.60*1.00, 0.40*1.00, 0.60*0.00, 0.40*0.00),
                           c(0.60*0.00, 0.40*0.00, 0.60*1.00, 0.40*1.00),
                           c(0.60*0.00, 0.40*1.00, 0.60*1.00, 0.40*0.00),
                           c(0.60*1.00, 0.40*0.00, 0.60*0.00, 0.40*1.00))

# this for loop loops over the four possible weighting schemes that match with
# those scenarios to calculate the AMCEs
for(i in 1:length(type_weights_four)){
  AMCE_abortion_four <- c(AMCE_abortion_four, amce_compute_abstain(vote.mat, pos=1, value.baseline="C", value.amce="L", weights = type_weights_four[[i]], idvar = "type")$amce)
  AMCE_taxes_four <- c(AMCE_taxes_four, amce_compute_abstain(vote.mat, pos=2, value.baseline="I", value.amce="D", weights = type_weights_four[[i]], idvar = "type")$amce)
}

# AMCE values for candidates whose abortion policy position is pro-life
round(AMCE_abortion_four, 3)
# AMCE values for candidates whose tax policy position is to decrease taxes
round(AMCE_taxes_four, 3)

# Tables SM.2-SM4 provide a more detailed walkthrough of how the AMCEs are
# calculated in each scenario where abstention is possible by indicating which
# specific matchups lead to abstentions and how the resulting vote tallies
# are used to calculate the AMCEs.

#############
# FIGURE SM.1  
#############

# In this figure, we expand our stylized example to consider N voters and vary
# the proportion of voters of each type in the population and the proportion
# of each type of voter who might abstain.  To calculate the AMCEs across 
# scenarios, we utilize the same functions and dataframe of voter preferences as
# above but expand the number of possible voter type weights

type_weights_full <- list(c(0.50*1.00, 0.50*1.00, 0.50*0.00, 0.50*0.00), # uniform abstention 50/50
                           c(0.50*0.90, 0.50*0.90, 0.50*0.10, 0.50*0.10), 
                           c(0.50*0.80, 0.50*0.80, 0.50*0.20, 0.50*0.20), 
                           c(0.50*0.70, 0.50*0.70, 0.50*0.30, 0.50*0.30),
                           c(0.50*0.60, 0.50*0.60, 0.50*0.40, 0.50*0.40), 
                           c(0.50*0.50, 0.50*0.50, 0.50*0.50, 0.50*0.50), 
                           c(0.50*0.40, 0.50*0.40, 0.50*0.60, 0.50*0.60), 
                           c(0.50*0.30, 0.50*0.30, 0.50*0.70, 0.50*0.70), 
                           c(0.50*0.20, 0.50*0.20, 0.50*0.80, 0.50*0.80), 
                           c(0.50*0.10, 0.50*0.10, 0.50*0.90, 0.50*0.90),
                           c(0.50*0.00, 0.50*0.00, 0.50*1.00, 0.50*1.00),
                           
                           c(0.60*1.00, 0.40*1.00, 0.60*0.00, 0.40*0.00), # uniform abstention 60/40
                           c(0.60*0.90, 0.40*0.90, 0.60*0.10, 0.40*0.10), 
                           c(0.60*0.80, 0.40*0.80, 0.60*0.20, 0.40*0.20), 
                           c(0.60*0.70, 0.40*0.70, 0.60*0.30, 0.40*0.30),
                           c(0.60*0.60, 0.40*0.60, 0.60*0.40, 0.40*0.40), 
                           c(0.60*0.50, 0.40*0.50, 0.60*0.50, 0.40*0.50), 
                           c(0.60*0.40, 0.40*0.40, 0.60*0.60, 0.40*0.60), 
                           c(0.60*0.30, 0.40*0.30, 0.60*0.70, 0.40*0.70), 
                           c(0.60*0.20, 0.40*0.20, 0.60*0.80, 0.40*0.80), 
                           c(0.60*0.10, 0.40*0.10, 0.60*0.90, 0.40*0.90),
                           c(0.60*0.00, 0.40*0.00, 0.60*1.00, 0.40*1.00),
                           
                           c(0.40*1.00, 0.60*1.00, 0.40*0.00, 0.60*0.00), # uniform abstention 40/60
                           c(0.40*0.90, 0.60*0.90, 0.40*0.10, 0.60*0.10), 
                           c(0.40*0.80, 0.60*0.80, 0.40*0.20, 0.60*0.20), 
                           c(0.40*0.70, 0.60*0.70, 0.40*0.30, 0.60*0.30),
                           c(0.40*0.60, 0.60*0.60, 0.40*0.40, 0.60*0.40), 
                           c(0.40*0.50, 0.60*0.50, 0.40*0.50, 0.60*0.50), 
                           c(0.40*0.40, 0.60*0.40, 0.40*0.60, 0.60*0.60), 
                           c(0.40*0.30, 0.60*0.30, 0.40*0.70, 0.60*0.70), 
                           c(0.40*0.20, 0.60*0.20, 0.40*0.80, 0.60*0.80), 
                           c(0.40*0.10, 0.60*0.10, 0.40*0.90, 0.60*0.90),
                           c(0.40*0.00, 0.60*0.00, 0.40*1.00, 0.60*1.00),
                           
                           c(0.50*1.00, 0.50*1.00, 0.50*0.00, 0.50*0.00), # type 1 abstention only 50/50
                           c(0.50*0.90, 0.50*1.00, 0.50*0.10, 0.50*0.00), 
                           c(0.50*0.80, 0.50*1.00, 0.50*0.20, 0.50*0.00), 
                           c(0.50*0.70, 0.50*1.00, 0.50*0.30, 0.50*0.00),
                           c(0.50*0.60, 0.50*1.00, 0.50*0.40, 0.50*0.00), 
                           c(0.50*0.50, 0.50*1.00, 0.50*0.50, 0.50*0.00), 
                           c(0.50*0.40, 0.50*1.00, 0.50*0.60, 0.50*0.00), 
                           c(0.50*0.30, 0.50*1.00, 0.50*0.70, 0.50*0.00), 
                           c(0.50*0.20, 0.50*1.00, 0.50*0.80, 0.50*0.00), 
                           c(0.50*0.10, 0.50*1.00, 0.50*0.90, 0.50*0.00),
                           c(0.50*0.00, 0.50*1.00, 0.50*1.00, 0.50*0.00),
                           
                           c(0.60*1.00, 0.40*1.00, 0.60*0.00, 0.40*0.00), # type 1 abstention only 60/40
                           c(0.60*0.90, 0.40*1.00, 0.60*0.10, 0.40*0.00), 
                           c(0.60*0.80, 0.40*1.00, 0.60*0.20, 0.40*0.00), 
                           c(0.60*0.70, 0.40*1.00, 0.60*0.30, 0.40*0.00),
                           c(0.60*0.60, 0.40*1.00, 0.60*0.40, 0.40*0.00), 
                           c(0.60*0.50, 0.40*1.00, 0.60*0.50, 0.40*0.00), 
                           c(0.60*0.40, 0.40*1.00, 0.60*0.60, 0.40*0.00), 
                           c(0.60*0.30, 0.40*1.00, 0.60*0.70, 0.40*0.00), 
                           c(0.60*0.20, 0.40*1.00, 0.60*0.80, 0.40*0.00), 
                           c(0.60*0.10, 0.40*1.00, 0.60*0.90, 0.40*0.00),
                           c(0.60*0.00, 0.40*1.00, 0.60*1.00, 0.40*0.00),
                           
                           c(0.40*1.00, 0.60*1.00, 0.40*0.00, 0.60*0.00), # type 1 abstention only 40/60
                           c(0.40*0.90, 0.60*1.00, 0.40*0.10, 0.60*0.00), 
                           c(0.40*0.80, 0.60*1.00, 0.40*0.20, 0.60*0.00), 
                           c(0.40*0.70, 0.60*1.00, 0.40*0.30, 0.60*0.00),
                           c(0.40*0.60, 0.60*1.00, 0.40*0.40, 0.60*0.00), 
                           c(0.40*0.50, 0.60*1.00, 0.40*0.50, 0.60*0.00), 
                           c(0.40*0.40, 0.60*1.00, 0.40*0.60, 0.60*0.00), 
                           c(0.40*0.30, 0.60*1.00, 0.40*0.70, 0.60*0.00), 
                           c(0.40*0.20, 0.60*1.00, 0.40*0.80, 0.60*0.00), 
                           c(0.40*0.10, 0.60*1.00, 0.40*0.90, 0.60*0.00),
                           c(0.40*0.00, 0.60*1.00, 0.40*1.00, 0.60*0.00),
                           
                           c(0.50*1.00, 0.50*1.00, 0.50*0.00, 0.50*0.00), # type 2 abstention only 50/50
                           c(0.50*1.00, 0.50*0.90, 0.50*0.00, 0.50*0.10), 
                           c(0.50*1.00, 0.50*0.80, 0.50*0.00, 0.50*0.20), 
                           c(0.50*1.00, 0.50*0.70, 0.50*0.00, 0.50*0.30),
                           c(0.50*1.00, 0.50*0.60, 0.50*0.00, 0.50*0.40), 
                           c(0.50*1.00, 0.50*0.50, 0.50*0.00, 0.50*0.50), 
                           c(0.50*1.00, 0.50*0.40, 0.50*0.00, 0.50*0.60), 
                           c(0.50*1.00, 0.50*0.30, 0.50*0.00, 0.50*0.70), 
                           c(0.50*1.00, 0.50*0.20, 0.50*0.00, 0.50*0.80), 
                           c(0.50*1.00, 0.50*0.10, 0.50*0.00, 0.50*0.90),
                           c(0.50*1.00, 0.50*0.00, 0.50*0.00, 0.50*1.00),
                           
                           c(0.60*1.00, 0.40*1.00, 0.60*0.00, 0.40*0.00), # type 2 abstention only abstention 60/40
                           c(0.60*1.00, 0.40*0.90, 0.60*0.00, 0.40*0.10), 
                           c(0.60*1.00, 0.40*0.80, 0.60*0.00, 0.40*0.20), 
                           c(0.60*1.00, 0.40*0.70, 0.60*0.00, 0.40*0.30),
                           c(0.60*1.00, 0.40*0.60, 0.60*0.00, 0.40*0.40), 
                           c(0.60*1.00, 0.40*0.50, 0.60*0.00, 0.40*0.50), 
                           c(0.60*1.00, 0.40*0.40, 0.60*0.00, 0.40*0.60), 
                           c(0.60*1.00, 0.40*0.30, 0.60*0.00, 0.40*0.70), 
                           c(0.60*1.00, 0.40*0.20, 0.60*0.00, 0.40*0.80), 
                           c(0.60*1.00, 0.40*0.10, 0.60*0.00, 0.40*0.90),
                           c(0.60*1.00, 0.40*0.00, 0.60*0.00, 0.40*1.00),
                           
                           c(0.40*1.00, 0.60*1.00, 0.40*0.00, 0.60*0.00), # type 2 abstention only abstention 40/60
                           c(0.40*1.00, 0.60*0.90, 0.40*0.00, 0.60*0.10), 
                           c(0.40*1.00, 0.60*0.80, 0.40*0.00, 0.60*0.20), 
                           c(0.40*1.00, 0.60*0.70, 0.40*0.00, 0.60*0.30),
                           c(0.40*1.00, 0.60*0.60, 0.40*0.00, 0.60*0.40), 
                           c(0.40*1.00, 0.60*0.50, 0.40*0.00, 0.60*0.50), 
                           c(0.40*1.00, 0.60*0.40, 0.40*0.00, 0.60*0.60), 
                           c(0.40*1.00, 0.60*0.30, 0.40*0.00, 0.60*0.70), 
                           c(0.40*1.00, 0.60*0.20, 0.40*0.00, 0.60*0.80), 
                           c(0.40*1.00, 0.60*0.10, 0.40*0.00, 0.60*0.90),
                           c(0.40*1.00, 0.60*0.00, 0.40*0.00, 0.60*1.00)
                      )

# these empty objects will become vectors storing the AMCEs from each possible
# voter distribution
AMCE_abortion_full <- NULL
AMCE_taxes_full <- NULL

for(i in 1:length(type_weights_full)){
  AMCE_abortion_full <- c(AMCE_abortion_full, amce_compute_abstain(vote.mat, pos=1, value.baseline="C", value.amce="L", weights = type_weights_full[[i]], idvar = "type")$amce)
  AMCE_taxes_full <- c(AMCE_taxes_full, amce_compute_abstain(vote.mat, pos=2, value.baseline="I", value.amce="D", weights = type_weights_full[[i]], idvar = "type")$amce)
}

pdf(file = "../figures/figure_SM1.pdf", family = "Times", height = 13, width = 10)
layout(matrix(c(1,2,3,4,5,6,7,8,9,10,11,12,13,13,13), nrow=5, byrow=TRUE), 
       widths = c(0.30, 0.35, 0.35), heights = c(0.10, 0.27, 0.27, 0.27, 0.15))
par(mar=c(0,0,0,0))
plot(0,0, type="n", axes=FALSE, xlab="", ylab="")
text(x=0.03, y=0, "Which Voters\nCan Abstain?", cex=3)
par(mar=c(0,0,0,0))
plot(0,0, type="n", axes=FALSE, xlab="", ylab="")
text(x=0.2, y=0, "Pro-Life AMCE", cex=2.5)
plot(0,0, type="n", axes=FALSE, xlab="", ylab="")
text(x=0.175, y=0, "Cutting Taxes AMCE", cex=2.5)
plot(0,0, type="n", axes=FALSE, xlab="", ylab="")
text(x=0.03, y=0, "Both Types\n(Equal Proportions)", cex=2.25)
par(mar=c(8,6,2,1))
plot(y = AMCE_abortion_full[1:11], x = 1:11, ylim = c(-0.30, 0.30),
     xaxt='n', type = "o", pch = 2,
     ylab = "AMCE", xlab = "Proportion Abstaining",
     col = "grey70", cex.lab=2, cex.axis=2, cex=1.5
)
axis(side = 1, at = c(1:11), labels = c("0%", "10%", "20%", "30%", "40%", "50%", "60%", "70%", "80%", "90%", "100%"), cex.axis=2)
lines(y = AMCE_abortion_full[12:22], x = 1:11, col = "black", type = "o", pch = 18, lty = 2, lwd=1.5, cex=1.5)
lines(y = AMCE_abortion_full[23:33], x = 1:11, col = "grey40", type = "o", pch = 19, lty=3, lwd=1.5, cex=1.5)
par(mar=c(8,6,2,1))
plot(y = AMCE_taxes_full[1:11], x = 1:11, ylim = c(-0.30, 0.30),
     xaxt='n', type = "o", pch = 2,
     ylab = "AMCE", xlab = "Proportion Abstaining",
     col = "grey70", cex.lab=2, cex.axis=2, cex=1.5
)
axis(side = 1, at = c(1:11), labels = c("0%", "10%", "20%", "30%", "40%", "50%", "60%", "70%", "80%", "90%", "100%"), cex.axis=2)
lines(y = AMCE_taxes_full[12:22], x = 1:11, col = "black", type = "o",  pch = 18, lty = 2, lwd=1.5, cex=1.5)
lines(y = AMCE_taxes_full[23:33], x = 1:11, col = "grey40", type = "o", pch = 19, lty=3, lwd=1.5, cex=1.5)
plot(0,0, type="n", axes=FALSE, xlab="", ylab="")
text(x=0.03, y=0, "Type 1 Voters Only", cex=2.25)
par(mar=c(8,6,2,1))
plot(y = AMCE_abortion_full[34:44], x = 1:11, ylim = c(-0.30, 0.30),
     xaxt='n', type = "o", pch = 2,
     ylab = "AMCE", xlab = "Proportion Abstaining",
     col = "grey70", cex.lab=2, cex.axis=2, cex=1.5
)
axis(side = 1, at = c(1:11), labels = c("0%", "10%", "20%", "30%", "40%", "50%", "60%", "70%", "80%", "90%", "100%"), cex.axis=2)
lines(y = AMCE_abortion_full[45:55], x = 1:11, col = "black", type = "o",  pch = 18, lty = 2, lwd=1.5, cex=1.5)
lines(y = AMCE_abortion_full[56:66], x = 1:11, col = "grey40", type = "o", pch = 19, lty=3, lwd=1.5, cex=1.5)
par(mar=c(8,6,2,1))
plot(y = AMCE_taxes_full[34:44], x = 1:11, ylim = c(-0.30, 0.30),
     xaxt='n', type = "o", pch = 2,
     ylab = "AMCE", xlab = "Proportion Abstaining",
     col = "grey70", cex.lab=2, cex.axis=2, cex=1.5
)
axis(side = 1, at = c(1:11), labels = c("0%", "10%", "20%", "30%", "40%", "50%", "60%", "70%", "80%", "90%", "100%"), cex.axis=2)
lines(y = AMCE_taxes_full[45:55], x = 1:11, col = "black", type = "o",  pch = 18, lty = 2, lwd=1.5, cex=1.5)
lines(y = AMCE_taxes_full[56:66], x = 1:11, col = "grey40", type = "o", pch = 19, lty=3, lwd=1.5, cex=1.5)
plot(0,0, type="n", axes=FALSE, xlab="", ylab="")
text(x=0.03, y=0, "Type 2 Voters Only", cex=2.25)
par(mar=c(8,6,2,1))
plot(y = AMCE_abortion_full[67:77], x = 1:11, ylim = c(-0.30, 0.30),
     xaxt='n', type = "o", pch = 2,
     ylab = "AMCE", xlab = "Proportion Abstaining",
     col = "grey70", cex.lab=2, cex.axis=2, cex=1.5
)
axis(side = 1, at = c(1:11), labels = c("0%", "10%", "20%", "30%", "40%", "50%", "60%", "70%", "80%", "90%", "100%"), cex.axis=2)
lines(y = AMCE_abortion_full[78:88], x = 1:11, col = "black", type = "o",  pch = 18, lty = 2, lwd=1.5, cex=1.5)
lines(y = AMCE_abortion_full[89:99], x = 1:11, col = "grey40", type = "o", pch = 19, lty=3, lwd=1.5, cex=1.5)
par(mar=c(8,6,2,1))
plot(y = AMCE_taxes_full[67:77], x = 1:11, ylim = c(-0.30, 0.30),
     xaxt='n', type = "o", pch = 2,
     ylab = "AMCE", xlab = "Proportion Abstaining",
     col = "grey70", cex.lab=2, cex.axis=2, cex=1.5
)
axis(side = 1, at = c(1:11), labels = c("0%", "10%", "20%", "30%", "40%", "50%", "60%", "70%", "80%", "90%", "100%"), cex.axis=2)
lines(y = AMCE_taxes_full[78:88], x = 1:11, col = "black", type = "o",  pch = 18, lty = 2, lwd=1.5, cex=1.5)
lines(y = AMCE_taxes_full[89:99], x = 1:11, col = "grey40", type = "o", pch = 19, lty=3, lwd=1.5, cex=1.5)

par(mar=c(0,0,0,0))
plot(0,0, type="n", axes=FALSE, xlab="", ylab="")
legend(x = 0, y = 1, legend=c("50% Type 1, 50% Type 2",
                              "60% Type 1, 40% Type 2",
                              "40% Type 1, 60% Type 2"),
       lty=c(1,2,3), pch=c(2,18,19), col=c("grey70", "black", "grey40"), ncol = 1,
       title="Proportions of Voter Types", cex=2)

dev.off()

#######################
# ADDITIONAL EXTENSIONS
#######################

# As we note on pages SM17-SM18, we examined additional extensions in which we 
# relax two assumptions made--that voters have heterogeneous preferences over
# the two attributes and that both types of voters prioritize the attributes
# in the same order.

# run through our six scenarios
# 1) homogeneous preferences for both attributes and identical prioritization
create_sim_scenario(attribute1="homogeneous", attribute2="homogeneous", priority="identical", path="../figures/mechanical_homo_homo_identical.pdf")

# 2) homogeneous preferences for both attributes and disparate prioritization 
# (i.e., voter type 1 care most about abortion policy but voter type 2 cares most about tax policy)
create_sim_scenario(attribute1="homogeneous", attribute2="homogeneous", priority="disparate", path="../figures/mechanical_homo_homo_disparate.pdf")

# 3) heterogeneous preferences for both attributes and identical prioritization
create_sim_scenario(attribute1="heterogenous", attribute2="heterogenous", priority="identical", path="../figures/mechanical_hetero_hetero_identical.pdf")

# 4) heterogeneous preferences for both attributes and disparate prioritization
create_sim_scenario(attribute1="heterogenous", attribute2="heterogenous", priority="disparate", path="../figures/mechanical_hetero_hetero_disparate.pdf")

# 5) homogeneous preferences on the most preferred attribute and identical prioritization
create_sim_scenario(attribute1="homogeneous", attribute2="heterogenous", priority="identical", path="../figures/mechanical_homo_hetero_identical.pdf")

# 6) heterogeneous preferences on the most preferred attribute and identical prioritization
create_sim_scenario(attribute1="heterogenous", attribute2="homogeneous", priority="identical", path="../figures/mechanical_hetero_homo_identical.pdf")
